The goal for this workshop is to create a basic web mapping application, where you can display polygons and rasters on a basemap. This web map should be accessible to anyone with an internet connection via web browser, like Google Chrome or Mozilla Firefox.
This workshop assumes you have a basic understanding of the following
tools: - Git (GitHub) - R programming and using RStudio - Spatial
analyses in R using sf and terra packages
The source code and examples for this workshop can be found here: https://github.com/JayMatsushiba/Tutorial-R-Shiny-Web-Mapping
Before we get into how to build a web mapping application, we should ask ourselves what are the advantages of building these in the first place. With traditional GIS, with software like ArcGIS Pro and QGIS, we can do all sorts of powerful spatial analyses. However, the challenge is sharing our information. While we can send files to other people, the appearance and the interpretation of our data will be different depending on how the recipient accesses the information. This also poses a barrier if we want to engage people that aren’t necessarily GIS experts. With web maps, we can craft visualizations and interactions with our spatial data that are in line with the narrative that we want to communicate. We also make our work much more accessible to a broader audience.
There are web mapping platforms that exist, such as ArcGIS Online, that are capable and can be used to achieve similar results to what we will learn in this workshop. However, these platforms are paid and closed-source, forcing us to be locked in to one company. With creating Web Maps with R Shiny, we stick with open-source software to analyze and visualize the data. We have the flexibility to choose where to host our application depending on our needs, including free options.
Here is an example of what is possible with this combination of tools: https://jaymatsushiba.shinyapps.io/Global_Sharks_Rays_Conservation_Tool/
Happy Git and GitHub for the useR by Jennifer Bryan https://happygitwithr.com/
Shiny Basics https://shiny.posit.co/r/getstarted/shiny-basics/lesson1/index.html
Mastering Shiny by Hadley Wickham https://mastering-shiny.org/index.html
Using Leaflet with Shiny https://rstudio.github.io/leaflet/articles/shiny.html
While setting up a project to work with Git and GitHub may be an extra step, it is really useful and important for keeping our work organized and accessible.
Using Git and GitHub in itself can be an entire workshop in itself, so we will keep it as brief and straightforward as possible here. The reason why we use Git and GitHub is for a number of reasons. Firstly, it provides a backup to your work in case something happens to your computer. Secondly, it makes it easier to share code and keep it updated, compared to emailing random files around. Thirdly, it provides many tools for collaboration and is the main reason why I use Git and GitHub as part of my workflow.
You may be confused by the distinction between Git and GitHub. Git refers to the system of organizing code changes, while GitHub is a service that runs Git on the cloud (meaning over the internet on a different computer from your own).
A repository in broad terms is a place that stores the code for a
given project. We can think of it as a folder with some fancy features,
including the ability to keep track of changes made to it over time. The
easiest way to create a new GitHub repository is through their website
(https://github.com/).
Click on the link and follow the instructions to create an account if
you don’t have one already.
You can name your repository whatever you want, but I suggest something that is descriptive for the project that you are working on. I will be using “Tutorial-R-Shiny-Web-Mapping”
Depending on your operating system (Windows, MacOS, Linux), installation instructions for git are different.
See this link for installation recommendations by OS. https://happygitwithr.com/install-git
Okay, let’s get started in RStudio! Open the RStudio IDE software.
Running this line of code will open a link in your browser, leading you to create a GitHub Personal Access Token (PAT), which will be used for enabling access to the GitHub repository from RStudio.
usethis::create_github_token()
Keep this window open, because we will need the token displayed at the
top of the page for setting our credentials in RStudio.
We need to add our credentials to RStudio using the next command. Run this in your RStudio console and paste in the PAT from the web page in the previous step.
gitcreds::gitcreds_set()
Now, you should be able to create a new R Project that is linked to
the GitHub repository that you created earlier.
You should now have a R Project set up that we can work in that is version controlled with GitHub. This means that we can save our progress while backing it up to GitHub, as well as rollback to different versions in case we break something along the way. There is a lot that Git and GitHub can do that can make your work more efficient and easier to share, but that would be outside of the scope of this particular workshop. The Happy Git and GitHub for the useR by Jennifer Bryan (https://happygitwithr.com/) is a really good resource for specifically using GitHub with RStudio, so consult that if you would like to learn more.
git commit and
git pushTo show how GitHub works with RStudio, let’s make our first .R file in our project.
Let’s put some content into this spatial.R. Copy and
paste the following code into the file. Save the changes to your
file.
# This will contain the spatial data analysis code for this workshop.
print("Hello World")
In the upper right window, there are a few tabs, including one that
says “Git”. Click that tab to open the view.
Click the “Commit” button in the “Git” view. This will open a new window. Here, you can decide what changes to your repository to commit, meaning record those changes as a version of your repository.
Check the box for R under “Staged”. This means these
selected changes will be part of the next commit. In the “Commit
message” box, it is best practice to write a short description about
what changes this commit contains. Then, you can click the “Commit”
button. After the commit, R should disappear as one of the
files listed in the table. To back these changes up onto GitHub, we need
to click the “Push” button with the upwards facing green arrow.
Now, if you check back to your GitHub page through your browser, you should be able to see these changes there! That means your Github and RStudio have been set up successfully. You should be repeating this “git commit” and “git push” operation throughout your work as best practice.
Important Note: GitHub has a maximum individual file size of 100 MB, and will not allow uploads for files larger than this. However, git will still allow you to commit additions and changes to large files like this (since this is a GitHub limitation rather than for git). It can be quite a hassle to fix if you accidentally commit a large file, so make sure you do not do this. Simply deleting the large files will not fix the problem, since the large files become part of the repository’s versions after being committed.
Addressing these problems are beyond this workshop, but see here for additional context: https://stackoverflow.com/questions/2100907/how-can-i-remove-delete-a-large-file-from-the-commit-history-in-the-git-reposito
sf and
terraLet’s get started on working with spatial data in R! We will continue
to work out of R/spatial.R, which should look like this at
this point after being committed and pushed to GitHub in the previous
step:
# This will contain the spatial data analysis code for this workshop.
print("Hello World")
Let’s remove the print("Hello World") and load the
relevant packages. Install the packages if you haven’t done that
yet.
# This will contain the spatial data analysis code for this workshop.
library(sf)
library(terra)
library(tidyverse)
We need some spatial data! I have a folder of sample data hosted on
GitHub that you can download here: https://github.com/JayMatsushiba/Tutorial-R-Shiny-Web-Mapping.git.
You can download the files individually in the data folder,
or you can git clone the whole repository (which includes a
sample Spatial Shiny App). The process for cloning the repository is
actually the same as linking to a new project, so follow the steps in
the Create new R Project that is linked to GitHub
repository section again, just with the link to my repo
instead. Copy the data folder from my repository into your
own project.
Common file formats for spatial data include shapefiles (.shp with
associated files), .geojson, .geotiff, etc. (there are so many…).
Generally though, we can read in vector spatial data with
st_read("filepath_here") and raster data with
rast("filepath_here").
# These are iNaturalist observations of the American Black Bear in British Columbia
# This is an example of a point data.
black_bear_observations_bc <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
# This is a polygon representing the boundaries of Burnaby
# https://data.burnaby.ca/datasets/d903b87782734451ae286cb0b59938ac
burnaby <- st_read("data/Burnaby_Boundary/Burnaby_Boundary.shp")
# This is a multipolygon representing British Columbia
# https://open.canada.ca/data/en/dataset/a883eb14-0c0e-45c4-b8c4-b54c4a819edb
british_columbia <- st_read("data/british_columbia/british_columbia.shp")
The spatial information is saved in the geometry column
of these objects, so we can access them this way:
plot(black_bear_observations_bc$geometry)
plot(burnaby$geometry)
plot(british_columbia$geometry)
Using the st_intersection() function, we can select the
points (y) that are within an area (x).
black_bear_observations_burnaby <- st_intersection(x = burnaby,
y = black_bear_observations_bc)
We can actually use ggplot to put multiple spatial layers onto one
plot. Only the black bear observations within Burnaby are plotted, since
we used the st_intersection() to clip the points to the
Burnaby boundary.
ggplot() +
geom_sf(data = burnaby) +
geom_sf(data = black_bear_observations_burnaby)
Using the same st_intersection() between two polygon
layers will act as a clip, returning the overlapping part of the two
polygons.
bc_without_burnaby <- st_intersection(burnaby, british_columbia)
Oh no! An error!
The st_crs() function returns the coordinate system of
the spatial object. This error means that the two input spatial objects
are not the same coordinate systems and therefore the
st_intersection() doesn’t work.
We can check the coordinate systems for each to verify:
st_crs(burnaby) # Coordinate system is WGS 84
st_crs(british_columbia) # Coordinate system is NAD83 / Statistics Canada Lambert
In order to remedy these issues, we can transform one of the layers to match the other.
burnaby_transformed <- st_transform(burnaby, st_crs(british_columbia))
burnaby_bc_clip <- st_intersection(burnaby_transformed, british_columbia)
Now we can look at what this looks like to clip British Columbia to Burnaby. While it looks different due to the transformation, this ends up just being the Burnaby boundary area because Burnaby is entirely contained by British Columbia.
ggplot() +
geom_sf(data = burnaby_bc_clip)
Let’s try making some buffers around Burnaby.
# The second parameter is the distance of the buffer
# The units depend on the coordinate reference system of the input layer.
burnaby_buffer <- st_buffer(burnaby_transformed, 2000)
ggplot() +
geom_sf(data = burnaby_buffer) +
geom_sf(data = burnaby, fill = "grey")
We can count the number of points that fall into each area by using
st_intersects(). This returns something different compared
to st_intersection(), as it returns the list of indexes of
the intersecting rows in the second object.
index <- st_intersects(burnaby, black_bear_observations_bc)
So for a simple count of a single polygon, we could just take the length of this list.
lengths(index)
Let’s do something more interesting with this, and get the counts of
observations across British Columbia over a regular grid cell. We need
to start with creating the grid cells using
st_make_grid().
grid <- st_make_grid(
british_columbia,
cellsize = 50000
)
# We can see that we created a regular sized grid over the area of BC.
ggplot() +
geom_sf(data = grid) +
geom_sf(data = british_columbia)
We can do the same st_intersects() operation between
this grid and the black bear observations. This will return a list of
lists, with one list of row indexes of the black bear observations that
intersect with each grid cell.
black_bear_observations_bc_transform <- black_bear_observations_bc %>%
st_transform(st_crs(grid)) # remembering that the CRS need to be the same
# This returns a list of lists
index_grid <- st_intersects(grid, black_bear_observations_bc_transform)
# This turns into a list of counts of observations in each grid cell
grid_count <- lengths(index_grid)
Since now we have a list of counts, which is ordered based on the
grid cell layer, we can simply column bind them together. We can take
that matrix and convert to a dataframe first, then into the spatial
object (sf). We renamed the grid column to
geometry, since that is the default name of the column with
the spatial information
# combine grid cells and counts
bear_observation_counts_grid <- cbind(grid, grid_count) %>%
as.data.frame() %>% # convert to dataframe, to allow conversion to sf
st_as_sf() %>% # convert to sf
st_set_crs(st_crs(grid)) %>% # make sure that the original CRS is assigned
rename(geometry = grid) %>% # rename to default geometry column name
mutate(grid_count = as.numeric(grid_count))
ggplot() +
scale_fill_viridis_c() +
geom_sf(data = bear_observation_counts_grid,
aes(fill = grid_count))
And we can clean this up a bit more by intersecting again with
British Columbia. This may take quite a long time, so we can skip this.
This is also a reason to use st_intersects() instead of
st_intersection() when possible.
bear_obs_counts_grids_clip <- st_intersection(bear_observation_counts_grid, british_columbia)
ggplot() +
scale_fill_viridis_c() +
geom_sf(data = bear_obs_counts_grids_clip,
aes(fill = grid_count))
To get started, let’s do an introduction on Shiny apps. Shiny apps
are a way to create interactive, well, applications using the R
language. In order to create Shiny apps, we need to distinguish how they
work in contrast to the interactive mode that we usually
use to work with R.
In typical R code, we run our code line by line. This is often called scripting, and we know our code runs from the top of the page to the bottom. We can also run this script one line at a time. That means we can write one line of code and run it.
x <- "hello world"
Then we can add another line of code and run it, and this would work correctly.
print(x)
However, when we create Shiny apps and then run them, we don’t have
the option of adding new lines of code and building upon the previous
steps while the app is running. In other words, the Shiny app will need
to contain all of the code to load in files, do the intended operations
on them, etc. This will become apparent as we go through the lab. In a
Shiny app, the code does not run from top to bottom of the page either,
instead relying on something called reactivity for defining
which code should run and when.
This part references Mastering Shiny (https://mastering-shiny.org/index.html). Please take a look there for additional context and learning.
Let’s create a new file called app.R. This single file
will contain all of the code we need for our Shiny app for now. The code
below has the basic structure of a Shiny App, and is pretty much the
simplest Shiny App that you can create.
# load the shiny library
library(shiny)
# This defines the user interface, which is the part that your users will see and interact with
ui <- fluidPage(
"Hello, world!"
)
# This defines the behaviour of the app.
# Currently, this is empty so our application doesn't do anything.
server <- function(input, output, session) {
}
# This line executes or starts the Shiny app
shinyApp(ui, server)
You should be able to click Run App above the app.R that
is open.
This should open a new window that shows your application.
Now this Shiny app is pretty boring, with no interactivity for the user. Let’s add some UI elements to the app. There are a number of premade UI elements that we will use (See https://mastering-shiny.org/basic-ui.html for more details on what is available). We unfortunately won’t have time to go over the range of UI possible with Shiny, as that could be a whole workshop in itself.
Let’s look at UI part of app.R again and add a couple
lines of code to begin creating the UI. Let’s clear the
"Hello World", and create some inputs. We’ll start with a
really simple text input and numeric input. These inputs are how we get
the user’s input to trigger or change some behaviour of the app.
# This defines the user interface, which is the part that your users will see and interact with
ui <- fluidPage(
textInput("name", "What is your name?"),
numericInput("number", "Enter a number",
value = 12,
min = 0,
max = 200)
numericInput(inputId = "number2",
label = "Enter a number",
value = 12,
min = 0,
max = 200)
)
Let’s also add a button, which we can later use to trigger some actions for the app.
# This defines the user interface, which is the part that your users will see and interact with
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
numericInput(inputId = "number",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
numericInput(inputId = "number2",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
actionButton(inputId = "click",
label = "Click Me!")
)
Note that every input has an inputId parameter. These
have to be unique values across all the UI elements, because this is how
we will access the values inputted into those UI elements.
Now, we can access the input values in the server function by the
input object. For example, we can access the
name inputId object in the server function by using
input$name.
Outputs are values that are calculated or retrieved by the server in
some function, which are then displayed somehow on the UI. Similarly to
inputs, outputs will have a unique outputId parameter.
Let’s review the complete app code at this stage. If we run this app, we see some ways to input data but it doesn’t seem to do anything. This is because we are missing outputs and the server code that describes the logic of the app.
library(shiny)
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
numericInput(inputId = "number",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
numericInput(inputId = "number2",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
actionButton(inputId = "click",
label = "Click Me!")
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Here, we will add a couple more lines to the UI of the app for the
outputs. These are two most simple outputs, with
textOutput() for regular text and
verbatimTextOutput() for code / console outputs.
library(shiny)
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
numericInput(inputId = "number",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
numericInput(inputId = "number2",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
actionButton(inputId = "click",
label = "Click Me!"),
textOutput(outputId = "text"),
verbatimTextOutput(outputId = "code")
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Now, if we run this app, still nothing would look different from the
previous steps, since we haven’t provided any server logic so far. Let’s
add some simple placeholder values into the server function. Similar to
inputs, we can access output variables using
output$the_outputId_of_output_UI.
server <- function(input, output, session) {
output$text <- renderText({
"Hello friend!"
})
output$code <- renderPrint({
5 * 20
})
}
Note that we can’t just pass a string or a bunch of code to each of
these outputs. We need to wrap them with a renderText() or
renderPrint(). These functions correspond to the the type
of output UI they are linking to. Later, we would use
renderLeaflet() in order to render maps. This
render function is necessary for enabling the output UI
elements to update when it’s inputs are changed
(reactivity), and for translating R code into HTML
(which is the language for the web page).
At this point, we have the basic inputs and outputs necessary to create our app, but our app doesn’t do anything. This is where we need to understand the concept of reactivity as used by Shiny.
Shiny apps use this concept called reactivity, which underpins their behaviour. This can be pretty tough to wrap your head around, since it is really different from scripting. As described earlier, a typical R script will run the code generally in order, from top to bottom. With Shiny apps, the order in which code is run does not follow this structure.
Instead, code is run depending on the changes to the
input object, which is defined by the user’s actions. As
other variables take the input as a dependency, they will
also get updated when input is updated. output
is really similar, but in the opposite direction where we change the
output object and those changes propagate to the output UI
elements.
Let’s try applying reactivity to our
app.R. Let’s simplify our code for now, and focus on the
textInput and textOutput here. If you try
running this Shiny app, you’ll notice that the textOutput
updates every time there is a change made to the user input. This means
the renderText() is running every time there is a change to
input$name.
library(shiny)
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
output$text <- renderText({
paste0("Hello ", input$name, "!")
})
}
shinyApp(ui, server)
We can also move the content of
renderText() into a reactive expression using
reactive(). This isn’t really necessary here, but it is
more useful as your applications become more complex. Something to
remember is that reactive() is a function, so we need to
write greeting() in order to access the value (i.e.,
running the function), rather than greeting.
library(shiny)
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
greeting <- reactive({
paste0("Hello ", input$name, "!")
})
output$text <- renderText({
greeting()
})
}
shinyApp(ui, server)
Now, we may not always want reactive behaviour. While the app runs fine updating for every change of input for something small, like one short text string representing a name, it would be a problem for a more complex operation. Imagine you wanted to run a model or spatial analysis that takes a few minutes. You would want to make sure you have all your inputs correct, and then trigger the function. It would be very frustrating if every input change automatically ran the model.
For this purpose, we can use something called
eventReactive() along with an actionButton().
This is really similar to what is in the previous chunk, with the main
difference that reactive() has been replaced by
eventReactive(). The first parameter of
eventReactive() is the input action that triggers the
change; in our case is the actionButton(). The second
parameter is the function that runs when the
eventReactive() is triggered.
library(shiny)
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
actionButton(inputId = "trigger", label = "Trigger"),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
greeting <- eventReactive(input$trigger, {
paste0("Hello ", input$name, "!")
})
output$text <- renderText({
greeting()
})
}
shinyApp(ui, server)
There is another function called observeEvent() that I
like to use for my Shiny apps, that is very similar to
eventReactive(). This is useful if you want to trigger some
code without returning its output into a new object. You can learn more
about them here: https://mastering-shiny.org/basic-reactivity.html#observers
Now, let’s revisit the application that we had at the end of the UI section. With what you learned about reactivity, can you change the behaviour of this application so that when the button is pressed, the UI outputs update to provide a greeting to the input name and multiplies the two input numbers together?
library(shiny)
ui <- fluidPage(
textInput(inputId = "name",
label = "What is your name?"),
numericInput(inputId = "number",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
numericInput(inputId = "number2",
label = "Enter a number",
value = 12,
min = 0,
max = 200),
actionButton(inputId = "click",
label = "Click Me!"),
textOutput(outputId = "text"),
verbatimTextOutput(outputId = "code")
)
server <- function(input, output, session) {
output$text <- renderText({
"Hello friend!"
})
output$code <- renderPrint({
5 * 20
})
}
shinyApp(ui, server)
One last thing we need to learn is how to load in data into the Shiny app. We will demonstrate this with a very simple Shiny app that just prints the code output.
library(shiny)
# Top Level:
# Code at this level runs once when the application is launched
ui <- fluidPage(
verbatimTextOutput(outputId = "code")
)
server <- function(input, output, session) {
# Middle Level:
# Code at this level runs once when a user visits the app
output$code <- renderPrint({
# Bottom Level:
# Code at this level runs every time its contents update
print("Testing!")
})
}
shinyApp(ui, server)
Since we only need to load in our data once when the application
launches, we can put the line of code at the top level. We can change
the print() in output$code to show that the
data has been loaded.
library(shiny)
library(sf)
# Top Level:
# Code at this level runs once when the application is launched
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
ui <- fluidPage(
verbatimTextOutput(outputId = "code")
)
server <- function(input, output, session) {
# Middle Level:
# Code at this level runs once when a user visits the app
output$code <- renderPrint({
# Bottom Level:
# Code at this level runs every time its contents update
print(black_bear_obs)
})
}
shinyApp(ui, server)
Here is a source that explains how this works: https://shiny.posit.co/r/getstarted/shiny-basics/lesson5/
Further reading: https://rstudio.github.io/leaflet/articles/shiny.html
Believe it or not, we already have the foundations necessary to
create a simple web map with Shiny! Let’s build off the simple app we
created for loading data by adding / swapping a couple lines of code.
This continues to follow the pattern of the
somethingOutput() on the UI side, paired with the
renderSomething() assigned to the
output$id.
A new function we are introducing is the leaflet()
function. We don’t need to understand how to use it in depth at this
point, but it is sort of similar to using something like
ggplot() but specifically for web maps.
library(shiny)
library(sf)
library(leaflet)
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
ui <- fluidPage(
# We can use leafletOutput like the other outputs
# Just need to pass a value to outputId
leafletOutput(outputId = "mymap")
)
server <- function(input, output, session) {
# Creating the output to mymap, which is our leafletOutput
output$mymap <- renderLeaflet({
# We create the leaflet object that will be displayed in the app
leaflet()
})
}
shinyApp(ui, server)
### Base Maps This is
completely empty map though, which isn’t very useful. Let’s add a
base map. A base map is essentially an
image that is spatially referenced, and usually used just for providing
visual context to the spatial data on the map. We generally cannot use
the base map for any additional spatial analyses or
access the input data that was used to create them through the
base map itself.
library(shiny)
library(sf)
library(leaflet)
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
ui <- fluidPage(
leafletOutput(outputId = "mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
# This is how we add a basemap on the leaflet
# provider basically means which base map to use
addProviderTiles(provider = providers$CartoDB.Positron)
})
}
shinyApp(ui, server)
This is starting to look more like what we think of as a web map! We can zoom into the map, change our view of the map, etc. At this point though, this doesn’t have any real data that we would like to show. Let’s change that.
Let’s add our black bear observations onto this map. This is actually
really easy as well, we just need to add a single line of code and use
the addCircles() function, feeding the data
parameter with the point dataset (black_bear_obs)
library(shiny)
library(sf)
library(leaflet)
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
ui <- fluidPage(
leafletOutput(outputId = "mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
# This is how we add points to a leaflet map
addCircles(data = black_bear_obs)
})
}
shinyApp(ui, server)
We can also add popups to each of these circles as well, so that it
shows some information from the spatial data when the circle is clicked
on. This is relatively simple as well. We just add the
popup parameter in addCircles() with the
~column that we want to have appear in the popup.
addCircles(data = black_bear_obs,
popup = ~observed_1)
This is essentially the same for the other spatial data as well, just with different functions.
# For adding polygons
leaflet() %>%
addPolygons(data = polygons)
# For adding lines
leaflet() %>%
addPolylines(data = polylines)
# For adding rasters
leaflet() %>%
addRasterImage(data = raster_data)
Can you add the Burnaby Boundary polygon to the map?
library(shiny)
library(sf)
library(leaflet)
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
burnaby <- st_read("data/Burnaby_Boundary/Burnaby_Boundary.shp")
ui <- fluidPage(
leafletOutput(outputId = "mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
addCircles(data = black_bear_obs,
popup = ~observed_1)
})
}
shinyApp(ui, server)
We are going to make a web map now, with the ability for the user to
filter points based off of dates of observations. This will really bring
together what we have learnt so far. We will also introduce another
library bslib for enhancing the look and feel of our web
map.
To start, we’ll introduce this template for the app:
library(shiny)
library(bslib)
library(sf)
library(leaflet)
# Define UI ----
# This is the main difference from what we have been doing
# We use page_sidebar() instead of fluidPage() for the UI
ui <- page_sidebar(
)
# Define server logic ----
server <- function(input, output) {
}
# Run the app ----
shinyApp(ui = ui, server = server)
Let’s add our title and sidebar:
library(shiny)
library(bslib)
library(sf)
library(leaflet)
# Define UI ----
# This is the main difference from what we have been doing
# We use page_sidebar() instead of fluidPage() for the UI
ui <- page_sidebar(
title = "Black Bear Observations Web Map",
sidebar = sidebar("Filter by Date"),
"This is where our main content will go"
)
# Define server logic ----
server <- function(input, output) {
}
# Run the app ----
shinyApp(ui = ui, server = server)
Let’s add some more UI to our app, including a date range input in the sidebar and a basic Leaflet map as the main content:
library(shiny)
library(bslib)
library(sf)
library(leaflet)
# Define UI ----
ui <- page_sidebar(
title = "Black Bear Observations Web Map",
sidebar = sidebar("Filter by Date",
dateRangeInput(inputId = "date_range",
label = "Date Range"),
actionButton(inputId = "filter_action",
label = "Filter")
),
leafletOutput(outputId = "mymap")
)
# Define server logic ----
server <- function(input, output) {
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron)
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Now, let’s add reading in the spatial data and basic visualization of it to the app:
library(shiny)
library(bslib)
library(sf)
library(leaflet)
# Reading in the black bear observations
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
# Define UI ----
ui <- page_sidebar(
title = "Black Bear Observations Web Map",
sidebar = sidebar("Filter by Date",
dateRangeInput(inputId = "date_range",
label = "Date Range"),
actionButton(inputId = "filter_action",
label = "Filter")
),
leafletOutput(outputId = "mymap")
)
# Define server logic ----
server <- function(input, output) {
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
# Adding the circle visualizations
addCircles(data = black_bear_obs,
popup = ~observed_1)
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Let’s set up accessing the date range inputs, and show the selected dates with a simple text output in the side bar.
library(shiny)
library(bslib)
library(sf)
library(leaflet)
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
# Define UI ----
ui <- page_sidebar(
title = "Black Bear Observations Web Map",
sidebar = sidebar("Filter by Date",
dateRangeInput(inputId = "date_range",
label = "Date Range"),
actionButton(inputId = "filter_action",
label = "Filter"),
# Adding some simple text outputs
textOutput(outputId = "text_start_date"),
textOutput(outputId = "text_end_date")
),
leafletOutput(outputId = "mymap")
)
# Define server logic ----
server <- function(input, output) {
# The eventReactive makes this update on the button press
start_date <- eventReactive(input$filter_action, {
# dateRangeInput() provides a vector of length 2
# the first object in this vector is the first date
input$date_range[1]
})
end_date <- eventReactive(input$filter_action, {
# the second object in this vector is the second date
input$date_range[2]
})
# These will automatically update when the reactive values update
# start_date() and end_date() are reactive values
output$text_start_date <- renderText({
paste0("Start date: ", start_date())
})
output$text_end_date <- renderText({
paste0("End date: ", end_date())
})
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
addCircles(data = black_bear_obs,
popup = ~observed_1)
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Time to make the big jump, and add some basic data processing within
the application. We will be querying the black_bear_obs
points by the dates that fall between the start_date and
end_date.
library(shiny)
library(bslib)
library(sf)
library(leaflet)
black_bear_obs <- st_read("data/black_bear_observations_bc/black_bear_observations_bc.shp")
# Define UI ----
ui <- page_sidebar(
title = "Black Bear Observations Web Map",
sidebar = sidebar("Filter by Date",
dateRangeInput(inputId = "date_range",
label = "Date Range"),
actionButton(inputId = "filter_action",
label = "Filter"),
# Adding some simple text outputs
textOutput(outputId = "text_start_date"),
textOutput(outputId = "text_end_date")
),
leafletOutput(outputId = "mymap")
)
# Define server logic ----
server <- function(input, output) {
start_date <- eventReactive(input$filter_action, {
input$date_range[1]
})
end_date <- eventReactive(input$filter_action, {
input$date_range[2]
})
output$text_start_date <- renderText({
paste0("Start date: ", start_date())
})
output$text_end_date <- renderText({
paste0("End date: ", end_date())
})
# Filtering the values of the black_bear_obs
# This needs to be in a reactive(), since this will trigger when its inputs are changed
# The inputs are changed with the eventReactive(), controlled by the button
# Therefore, this selected_black_bear_obs will also update each time the button is pressed
selected_black_bear_obs <- reactive({
# This queries dates that are within the start and end dates
black_bear_obs[black_bear_obs$observed_1 >= start_date() & black_bear_obs$observed_1 <= end_date(),]
})
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
# Remember to switch the data to the selected_black_bear_obs()
addCircles(data = selected_black_bear_obs(),
popup = ~observed_1)
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Congratulations, you have created your first fully fledged R Shiny web map! This is a lot to take in, so please pat yourself on the back for getting this far.
Can you create an interactive web map that displays the grid cell output with observation counts from Part 2?
Now that you have created your web map, we want to share it!
We will be using www.shinyapps.io to share our application to anyone in the world with an internet connection and a browser.
Full Getting Started Guide: https://docs.posit.co/shinyapps.io/guide/getting_started/
Go to www.shinyapps.io and follow the instructions for creating an account. They provide the option for joining with GitHub, so you should be able to one-click create a new account.
Install the rsconnect package, which we need to connect
to shinyapps.io
install.packages("rsconnect")
library(rsconnect)
Click your account name in the upper right part of the page, then
click the Tokens option.
This should open the Tokens page. Click on
Show on one of the tokens in the table, and this should
open a pop up with instructions on how to authorize in Rstudio to enable
deploying your application. Follow these instructions
Cick on the Publish button in the upper right corner
of your Shiny app code(probably called app.R).
You should see in the popup menu that your account is connected. Give
your application a name and click that publish button. This may take a
little while to deploy, so take this opportunity to stand up and
stretch, move around, relax.
This site was originally developed for Web Mapping with R Shiny Workshop Series at SFU delivered on September 20 and September 27, 2024.